home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sightmap / site.cls < prev    next >
Text File  |  1999-02-24  |  19KB  |  688 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Site"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. 'CLASS -- Site -- Site.cls
  17.  
  18. '--------------------------------------------------------------------------
  19. '<Purpose>
  20. '   Encapsulate the functions and data needed to build a site's map.
  21. '
  22. '--------------------------------------------------------------------------
  23.  
  24. Private strFiles() As String                'holds files for the site
  25. Private strSmallFiles() As String           'holds small (short) file names
  26. Private strUKFiles() As String              'Unknown files found
  27. Private strFilters() As String              'Filters to look for
  28. Private strFilterLen() As String            'lengths of each filter
  29. Private Matrix() As Integer                 'The adjacency matrix
  30. Private strDirs() As String                 'The directories to search
  31. Private intFilterCt As Integer              'amt of filters
  32. Private intUKFileCt As Integer              'amt of unknown files found
  33. Private intFileCt As Integer                'amt of files
  34. Private intDirCt As Integer                 'amt of directories
  35. Private strName As String                   'name of this site
  36. Private strMainDirectory As String          'main directory to start parsing
  37. Private strID As String                     'internal name for this site
  38. Private blnChooseRoot As Boolean            'did user provide start point
  39. Private strRoot As String                   'start point for map
  40. Private Visited() As Boolean                'Used by traversal algorithms
  41.  
  42. '*******************************************************************************
  43.  
  44. Private Function MapName(ByVal Vertex As String) As Integer
  45. Dim i As Integer
  46.  
  47.     Vertex = UCase$(Vertex)
  48.  
  49.     For i = 1 To intFileCt
  50.         If strSmallFiles(i) = Vertex Then
  51.             MapName = i
  52.             Exit For
  53.         End If
  54.     Next
  55.  
  56. End Function
  57. '*******************************************************************************
  58.  
  59. Public Sub RemoveFilter(intIndex As Integer)
  60. Dim i As Integer
  61.  
  62.  
  63.     strFilters(intIndex) = strFilters(intFilterCt)
  64.     ReDim Preserve strFilters(intFilterCt - 1)
  65.     intFilterCt = intFilterCt - 1
  66.     
  67. End Sub
  68.  
  69. '*******************************************************************************
  70.  
  71. Private Sub ResetVisited()
  72. Dim i As Integer
  73.  
  74.     For i = 1 To intFileCt
  75.         Visited(i) = False
  76.     Next
  77.     
  78. End Sub
  79.  
  80. '*******************************************************************************
  81. Public Sub SaveSite(strPath As String)
  82. On Error GoTo SaveSite_Error
  83.  
  84. Dim i As Integer        'lcv
  85. Dim j As Integer        'lcv
  86.  
  87.     Open strPath For Output As #1
  88.      
  89.     If intFileCt < 1 Then
  90.         Err.Raise vbObjectError + 1, "SaveSite", "Site not fully defined.  Cannot save at this time."
  91.     End If
  92.     
  93.     'write site id and name
  94.     Write #1, strID, strName
  95.     
  96.     'Write the number of files
  97.     Write #1, intFileCt
  98.     
  99.     'write the files and short file names
  100.     For i = 1 To intFileCt
  101.         Write #1, strFiles(i), strSmallFiles(i)
  102.     Next
  103.     
  104.     'write the adjacency matrix, row by row
  105.     For i = 1 To intFileCt
  106.         For j = 1 To intFileCt
  107.             Write #1, Matrix(i, j)
  108.         Next j
  109.     Next i
  110.     
  111.     'Write the number of filters
  112.     Write #1, intFilterCt
  113.     
  114.     'write the filters and filter lengths
  115.     For i = 1 To intFilterCt
  116.         Write #1, strFilters(i), strFilterLen(i)
  117.     Next
  118.     
  119.     'write the unknown file amt
  120.     Write #1, intUKFileCt
  121.     
  122.     'write out the uk files
  123.     For i = 1 To intUKFileCt
  124.         Write #1, strUKFiles(i)
  125.     Next
  126.     
  127.     'Write out number of directories
  128.     Write #1, intDirCt
  129.     
  130.     'Write out the directories holding the site
  131.     For i = 1 To intDirCt
  132.         Write #1, strDirs(i)
  133.     Next
  134.     
  135.     'write out the site root definition
  136.     Write #1, strMainDirectory, blnChooseRoot, strRoot
  137.     
  138.     
  139.     
  140.     Close #1
  141. Exit Sub
  142. SaveSite_Error:
  143.  
  144.     Close #1
  145.     Err.Raise vbObjectError + 1, "Save Site", CStr(Err.Number) & " -- " + Err.Description
  146.     
  147.  
  148. End Sub
  149.  
  150. '*******************************************************************************
  151. Public Sub OpenSite(strPath As String)
  152. On Error GoTo OpenSite_Error
  153.  
  154. Dim i As Integer        'lcv
  155. Dim j As Integer
  156.  
  157.     Open strPath For Input As #1
  158.     
  159.     Input #1, strID, strName
  160.     
  161.     'input the number of files
  162.     Input #1, intFileCt
  163.     
  164.     ReDim strFiles(intFileCt)
  165.     ReDim strSmallFiles(intFileCt)
  166.     ReDim Visited(intFileCt)
  167.     
  168.     'input the files and short file names
  169.     For i = 1 To intFileCt
  170.         Input #1, strFiles(i), strSmallFiles(i)
  171.     Next
  172.     
  173.     ReDim Matrix(intFileCt, intFileCt)
  174.     
  175.     'input the adjacency matrix, row by row
  176.     For i = 1 To intFileCt
  177.         For j = 1 To intFileCt
  178.             Input #1, Matrix(i, j)
  179.         Next j
  180.     Next i
  181.     
  182.     'input the number of filters
  183.     Input #1, intFilterCt
  184.     
  185.     ReDim strFilters(intFilterCt)
  186.     ReDim strFilterLen(intFilterCt)
  187.     
  188.     'input the filters and filter lengths
  189.     For i = 1 To intFilterCt
  190.         Input #1, strFilters(i), strFilterLen(i)
  191.     Next
  192.     
  193.     'input the unknown file amt
  194.     Input #1, intUKFileCt
  195.     
  196.     If intUKFileCt > 0 Then
  197.         ReDim strUKFiles(intFileCt)
  198.         
  199.         'input out the uk files
  200.         For i = 1 To intUKFileCt
  201.             Input #1, strUKFiles(i)
  202.         Next
  203.     End If
  204.     
  205.     'input out number of directories
  206.     Input #1, intDirCt
  207.     
  208.     If intDirCt > 0 Then
  209.         ReDim strDirs(intDirCt)
  210.         
  211.         'input out the directories holding the site
  212.         For i = 1 To intDirCt
  213.             Input #1, strDirs(i)
  214.         Next
  215.     End If
  216.     
  217.     'input out the site root definition
  218.     Input #1, strMainDirectory, blnChooseRoot, strRoot
  219.  
  220.  
  221.     Close #1
  222.  
  223. Exit Sub
  224. OpenSite_Error:
  225.  
  226.     Close #1
  227.     Err.Raise vbObjectError + 1, "Open Site", CStr(Err.Number) & " -- " + Err.Description
  228.     
  229. End Sub
  230. '*******************************************************************************
  231.  
  232. Private Function AllVisited() As Boolean
  233. Dim i As Integer
  234. Dim blnFlag As Boolean
  235.  
  236.     blnFlag = True
  237.     
  238.     For i = 1 To intFileCt
  239.         If Visited(i) = False Then
  240.             blnFlag = False
  241.             Exit For
  242.         End If
  243.     Next
  244.     
  245.     AllVisited = blnFlag
  246.  
  247. End Function
  248. '*******************************************************************************
  249.  
  250. Public Sub DrawTree(tv As TreeView)
  251. Dim n As Node
  252. Dim idx As Integer
  253. Dim j As Integer
  254. Dim intNodeIdx As Integer
  255. Dim blnAllVisited As Boolean
  256.  
  257.     blnAllVisited = False
  258.     
  259.     If blnChooseRoot Then
  260.         'Supplied root
  261.         idx = MapName(strRoot)
  262.         If idx = 0 Then
  263.             Exit Sub
  264.         End If
  265.     Else
  266.         'Divine the root!
  267.         idx = DivineRoot()
  268.         If idx > 0 Then
  269.             strRoot = strSmallFiles(idx)
  270.         Else
  271.             Exit Sub
  272.         End If
  273.     End If
  274.     
  275.     Call ResetVisited
  276.     
  277.     Set n = tv.Nodes.Add
  278.     n.Text = strName
  279.     intNodeIdx = 1
  280.     Visited(idx) = True
  281.     Set n = tv.Nodes.Add(intNodeIdx, tvwChild)
  282.     n.Text = strRoot
  283.     
  284.         
  285.     Call FillBranch(tv, n, idx, n.Index)
  286.    
  287. End Sub
  288. '*******************************************************************************
  289.  
  290. Private Sub FillBranch(tv As TreeView, n As Node, idx As Integer, intNodeIdx)
  291. 'Recursive
  292. Dim j As Integer
  293.     
  294.     
  295.     For j = 1 To intFileCt
  296.         If (Matrix(idx, j) = 1) And (idx <> j) And (Not Visited(j)) Then
  297.             'We have an edge
  298.             Set n = tv.Nodes.Add(intNodeIdx, tvwChild)
  299.             n.Text = strSmallFiles(j)
  300.             Visited(j) = True
  301.             If Not AllVisited() Then
  302.                 Call FillBranch(tv, n, j, n.Index)
  303.             End If
  304.         End If
  305.     Next